home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / 12B.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  40KB  |  1,234 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9. /* chapter 12, part b */
  10.  
  11. #include "hdr.h"
  12. #include "vars.h"
  13. #include "libp.h"
  14. #include "librp.h"
  15. #include "miscp.h"
  16. #include "smiscp.h"
  17. #include "dclmapp.h"
  18. #include "sspansp.h"
  19. #include "errmsgp.h"
  20. #include "nodesp.h"
  21. #include "setp.h"
  22. #include "chapp.h"
  23.  
  24. static void update_one_entry(Symbol, Symbol, Symbolmap);
  25. static void update_scalar_signature(Symbol, Symbol);
  26. static void update_record_entry(Symbol, Symbol, Symbolmap);
  27. static void update_array_entry(Symbol, Symbol, Symbolmap);
  28. static Node update_new_node(Node);
  29. static Symbol update_new_name(Symbolmap, Symbol);
  30. static void instantiate_derived_types(Node, Symbolmap);
  31. static Set update_overloads(Set, Symbolmap);
  32. static int check_recursive_instance(Node);
  33. static int scan_instance(Node);
  34. static void nodemap_free(Nodemap);
  35. static Node nodemap_get(Nodemap, Node);
  36. static void nodemap_put(Nodemap, Node, Node);
  37.  
  38. void instantiate_subprog_tree(Node node, Symbolmap type_map)
  39.   /*;instantiate_subprog_tree*/
  40. {
  41.     /* Build  the tree  for the instantiated object,  and the corresponding
  42.      * symbol table entries, some of which    may contain pointers to new tree.
  43.      */
  44.  
  45.     Node    id_node, gen_node, b_node, specs_node;
  46.     Symbol    prog_name, gen_name, g_p, new_p;
  47.     /* Nodemap    node_map; */
  48.     Tuple    sig, itup, packs;
  49.     Node    stmts_node, decl_node, handler_node;
  50.     Symbolmap    rename_map;
  51.     Tuple    truly_renamed;
  52.     Fortup      ft1;
  53.  
  54.     id_node   = N_AST1(node);
  55.     gen_node  = N_AST2(node);
  56.     prog_name = N_UNQ(id_node);
  57.     gen_name  = N_UNQ(gen_node);
  58.     /* instantiate all entities local to the subprogram. The type map is aug-
  59.      * mented with the mapping of local generic entities into their instances
  60.      */
  61.  
  62.     itup = instantiate_symbtab(gen_name, prog_name, type_map);
  63.     rename_map = (Symbolmap) itup[1];
  64.     packs = (Tuple)itup[2];
  65.     truly_renamed = (Tuple) itup[3];
  66.     /* Now use this mapping to instantiate the AST itself. */
  67.     node_map = nodemap_new();        /* global object. */
  68.     current_node = node;
  69.  
  70.     sig = SIGNATURE(gen_name);
  71.     b_node = (Node) sig[3];
  72.  
  73.     retrieve_generic_tree(b_node, (Node)0);    /* if in another file. */
  74.     /* Instantiate body and transform into subprogram node*/
  75.     specs_node   = N_AST1(b_node);
  76.     decl_node    = N_AST2(b_node);
  77.     stmts_node   = N_AST3(b_node);
  78.     handler_node = N_AST4(b_node);
  79.  
  80.     N_KIND(node) = as_subprogram;
  81.     N_AST1(node) = instantiate_tree(specs_node,   rename_map);
  82.     N_AST2(node) = instantiate_tree(decl_node,    rename_map);
  83.     N_AST3(node) = instantiate_tree(stmts_node,   rename_map);
  84.     N_AST4(node) = instantiate_tree(handler_node, rename_map);
  85.     /* Finally, complete the instantiation of the  symbol table. The later
  86.      * happens after  tree instantiation, to insure that symbtab instances 
  87.      * point to the instantiated nodes. The entry for the instance has been
  88.      * constructed by chain_overloads, and is not updated further.
  89.      */
  90.     truly_renamed = tup_with(truly_renamed, (char *) gen_name);
  91.     update_symbtab_nodes(rename_map, truly_renamed);
  92.  
  93.     /* Update the private declarations of enclosed packages */
  94.     FORTUP(g_p=(Symbol), packs, ft1);
  95.         new_p = symbolmap_get(rename_map, g_p);
  96.         private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
  97.     ENDFORTUP(ft1);
  98.     instantiate_derived_types(decl_node, rename_map);
  99.  
  100.     /*TBSL: should we free old node_map???    ds 7nov */
  101.     nodemap_free(node_map);        /* free current allocation */
  102.     node_map = nodemap_new();    /* discard after use. */
  103. }
  104.  
  105. void instantiate_pack_tree(Node node, Symbolmap type_map,
  106.   Tuple instance_list) /*;instantiate_pack_tree*/
  107. {
  108.     /* Build tree for  instantiated object, and symbol table entries for all
  109.      * its local entities. In the case of a forward instantiation, visibility
  110.      * rules  require that the symbol  table  of the visible  part    be  fully
  111.      * instantiated. The expander then instantiates the  symbol table for the
  112.      * body, together with the corresponding tree.
  113.      */
  114.     Node    id_node, gen_node;
  115.     Symbol    package, gen_name, g_p, new_p, new_f, sym, gen_formal, over;
  116.     /* Nodemap    node_map; */
  117.     Tuple    sig;
  118.     Node    priv_node, decl_node, b_node, spec_node, new_decl_node;
  119.     Node    new_priv_node;
  120.     Node    new_b_node;
  121.     Symbolmap    rename_map;
  122.     Tuple    ltup, itup, truly_renamed;
  123.     Tuple    packs, gen_tup, gen_list;
  124.     Fortup    ft1, ft2;
  125.     Forset    fs1, fs2;
  126.     Set      overloadables;
  127.     id_node = N_AST1(node);
  128.     gen_node = N_AST2(node);
  129.     package     = N_UNQ(id_node);
  130.     gen_name = N_UNQ(gen_node);
  131.  
  132.     /* Instantiate all entities local to the package. */
  133.     itup = instantiate_symbtab(gen_name, package, type_map);
  134.     rename_map = (Symbolmap)itup[1];
  135.     packs = (Tuple)itup[2];
  136.     truly_renamed = (Tuple) itup[3];
  137.     tup_free(itup); /* itup just used to pass result*/
  138.     /* Now instantiate the AST itself, and complete the instantiation of the
  139.      * symbol table. 
  140.      */
  141.     node_map = nodemap_new();            /* global object.*/
  142.     current_node = node;
  143.     sig = SIGNATURE(gen_name);
  144.     decl_node = (Node) sig[2];
  145.     priv_node = (Node) sig[3];
  146.     retrieve_generic_tree(decl_node, priv_node);
  147.     b_node = (Node) sig[4];
  148.     spec_node = node_new(as_package_spec);
  149.     new_decl_node = instantiate_tree(decl_node, rename_map);
  150.     new_priv_node = instantiate_tree(priv_node, rename_map);
  151.     /* N_LIST(new_decl_node) = instance_list + N_LIST(new_decl_node); */
  152.     N_LIST(new_decl_node) = tup_add(instance_list, N_LIST(new_decl_node));
  153.     N_AST1(spec_node) = id_node;
  154.     N_AST2(spec_node) = new_decl_node;
  155.     N_AST3(spec_node) = new_priv_node;
  156.     if (b_node != OPT_NODE) { /* Instantiate body as well */
  157.         retrieve_generic_tree(b_node, (Node)0);
  158.         new_b_node = instantiate_tree(b_node, rename_map);
  159.         N_KIND(new_b_node) = as_package_body;
  160.     }
  161.     else {
  162.         new_b_node = copy_node(node);
  163.         /* Attach tpe_map to node for eventual code emission */
  164.         ltup = tup_new(2);
  165.         ltup[1] = (char *) rename_map;
  166.         ltup[2] = (char *) needs_body(gen_name);
  167.         N_AST4(new_b_node) = new_instance_node(ltup);
  168.     }
  169.     /* In any case, emit the spec node before the body */
  170.     make_insert_node(node, tup_new1((char *) spec_node), new_b_node);
  171.  
  172.     /* Node references in the symbol table must point to the instantiated
  173.      * tree.
  174.      */
  175.     update_symbtab_nodes(rename_map, truly_renamed);
  176.  
  177.     /* Complete construction of visibility information for inner packages.    */
  178.     FORTUP(g_p=(Symbol), packs, ft1);
  179.         new_p = symbolmap_get(rename_map, g_p);
  180.         /* construct visible map for it, so that the proper instantiated
  181.          * entities within new package become accessible.
  182.          */
  183.         /* TBSL: review translation of next line */
  184.         /* 
  185.          *  visible(new_p) := { [id, symbolmap_get(rename_map, old_n) ? old_n] : 
  186.          *         [id, old_n] in  visible(g_p)};
  187.          */
  188.  
  189.         /*    
  190.          * Nested packages (which are not generic) are now visible: their
  191.          * local entities are nameable using qualified names.
  192.          */
  193.         if (NATURE(g_p) != na_generic_package
  194.             && NATURE(g_p) != na_generic_package_spec) {
  195.             vis_mods = tup_with(vis_mods, (char *) new_p);
  196.         }
  197.         /*
  198.          *The top level package is added to vis_mods in end_specs, called
  199.          * at the end of package_instance.
  200.          */
  201.         /* Finally, apply renamings to the private declarations. */
  202.         private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
  203.     ENDFORTUP(ft1);
  204.  
  205.     instantiate_derived_types(decl_node, rename_map);
  206.     /* The instantiation does not include a copy of the generic part. RM 12.3(5)
  207.      * Thus, the instantiation of the generic parameters themselves, is not
  208.      * visible. If, however, a generic subprogram parameter has an overload in
  209.      * the visible part of the package, that overload itself must remain
  210.      * accessible; so we just remove the name of the instantiated generic
  211.      * subprogram parameter from its own overloads set.
  212.      */
  213.     overloadables = set_new(0);
  214.     gen_list = (Tuple) SIGNATURE(gen_name)[1];
  215.     FORTUP(gen_tup = (Tuple), gen_list, ft2);
  216.         gen_formal = (Symbol) gen_tup[1];
  217.         new_f = symbolmap_get(rename_map, gen_formal);
  218.         if (new_f == (Symbol) 0)     /* error in instantiation */
  219.             /* TBSL: can we just return here ? */
  220.             continue;
  221.         if (NATURE(gen_formal)==na_procedure || NATURE(gen_formal)==na_function)
  222.             overloadables = set_with(overloadables, (char *) new_f);
  223.     ENDFORTUP(ft2);
  224.  
  225.     FORSET(sym=(Symbol), overloadables, fs1);
  226.